COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00006 00003	(declare (special foonum)(fixnum foonum))
C00007 ENDMK
C⊗;

(fasload browse)

(m-defun match (pat dat alist)
	 (qcatch 'match (match1 pat dat alist)))

(m-defun match1 (pat dat alist)
       (cond ((null pat)
	      (cond ((null dat)
		     (throw 'match t))))
	     ((null dat) ())
	     ((or (eq (car pat) '?)
		  (eq (car pat)
		      (car dat)))
	      (match1 (cdr pat) (cdr dat) alist))
	     ((eq (car pat) '*)
	      (funcall (qlambda t () (match1 (cdr pat) dat alist)) ())
	      (funcall (qlambda t () (match1 (cdr pat) (cdr dat) alist)) ())
	      (match1 pat (cdr dat) alist))
	     (t (cond ((atom (car pat))
		       (cond ((eq (char1 (car pat)) '?)
			      (let ((val (assq (car pat) alist)))
				   (cond (val (match1 (cons (cdr val)
							   (cdr pat))
						     dat alist))
					 (t (match1 (cdr pat)
						   (cdr dat)
						   (cons (cons (car pat)
							       (car dat))
							 alist))))))
			     ((eq (char1 (car pat)) '*)
			      (let ((val (assq (car pat) alist)))
				   (cond (val 
					  (match1 (append (cdr val)
							  (cdr pat))
						  dat alist))
					 (t 
					  (do ((l () (append l (ncons (car d))))
					       (e (cons () dat) (cdr e))
					       (d dat (cdr d)))
					      ((null e) ())
					      (funcall
					       (qlambda t () 
							(match1 (cdr pat) d
							       (cons (cons (car pat) 
									   l)
								     alist))) ())
					      ())))))))
		      (t (and 
			  (not (atom (car dat)))
			  (qcatch 'match (match1 (car pat)
						 (car dat) alist))
			  (match1 (cdr pat)
				  (cdr dat) alist)))))))

(m-defun browse ()
	 (seed)
	 (investigate 
	  (randomize 
	   (init 5. 5. 4. '((a a a b b b b a)
			    (a a (a a)(b b))
			    (a a a b (b a) b a b a))))
	  '((*a ?b *b ?b a)
	    (*a (*a) (*b))
	    (? ? * (b a) * ? ?))))

(m-defun investigate (units pats)
  (qcatch 'investigate
	  (do ((units units (cdr units)))
	      ((null units))
	      (do ((pats pats (cdr pats)))
		  ((null pats))
		  (do ((p (get (car units) 'pattern)
			  (cdr p)))
		      ((null p))
 		      (funcall (qlambda t () (match (car pats) (car p) ())) ())
		      ())))))
  
(setq *process-creation-time* 30.)

(do ((n 1. (+ n 1)))
    ((= n 33.) 'done)
    (make-multi-processor n)
    (meval '(browse)))

(declare (special foonum)(fixnum foonum))
(setq foonum 0)

(defun merger  (var num)
       (implode (append (explode var)
			(exploden num))))

(defun find-parts (var)
       (do ((a (exploden var)
	       (cdr a))
	    (b () (cons (car a) b)))
	   ((and (< #o57 (car a))
		 (< (car a) #o100))
	    (list (implode (reverse b)) (readlist a)))))

(find-parts 'abc12)

(merger 'abc 12)

(lm-let ((x 1)(y 2)) (+ x y))